MacWorld 1999 July

home *** CD-ROM | disk | FTP | other *** search

/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / setup < prev next >

Wrap

Text File | 1999-02-05 | 28KB | 1,109 lines

(* This is the first file compiled in the PPC Mops image. CROSS (in cg6) switches 68k Mops to generating PPC code. At the beginning of the code area, there's an info block with certain quantities we need to set everything up. Here's the format - note that this MUST AGREE with what we have in cg4/zPEF! ent pt offset length what it is 0 4 bytes initial branch 4 4 bytes code size 8 4 bytes data size 12 4 bytes displacement from code_start to nuc_code_start (i.e. code generator code area) 16 4 bytes displacement from data_start to nuc_data_start (i.e. code generator data area) 20 32 bytes initial CONTEXT 52 4 bytes flags 56 4 bytes #bytes chopped from bottom of seg 8 60 4 bytes #bytes chopped from bottom of seg 9 64 4 bytes total code size (including spare room) 68 4 bytes total data size (including spare room) 72 8 bytes spare total: 80 bytes. *) cross marker m__setup \ also marks the start of the PPC dic : NULL ; \ ================== REGISTER DEFINITIONS =================== \ r0 is scratch 0 constant false -1 constant true 1 constant sys_SP_reg 2 constant RTOC_reg 10 constant rZ_reg 11 constant rX_reg 12 constant rY_reg 13 constant mainCode_reg 14 constant mainData_reg 15 constant modCode_reg 16 constant modData_reg 17 constant RP_reg 18 constant SP_reg 19 constant FSP_reg 20 constant obj_base_reg 21 constant I_reg \ can be used for a local if no DO...LOOP \ or FOR...NEXT 22 constant do_limit_reg \ can be used for a local if no DO..LOOP 21 constant 1st_gpr_local 14 constant 1st_fpr_local \ Now we define some constants, values etc. which we need at setup time. \ Most of the others are defined near the start of pnuc1. 800 cells constant RSTACK_SIZE 1000 cells constant STACK_SIZE 200 3 << constant FSTACK_SIZE 4 constant 1CELL $ 7FFFFFFF constant BIG# 65520 constant DISPL_RANGE \ what we can fit in a signed 16-bits \ displacement, rounded down to \ 8-byte alignment 32760 constant HALF_DISPL_RANGE $ FFFF8103 constant nilP $ FFFF8101 constant nilH $ 7FF01000 constant quietNAN \ NAN(128) (quiet) 204 constant FCBlen 30 constant HOLDlen 200 constant PADlen 400 constant TIBlen 512 constant ErrDumpLen true constant PPC? \ ALWAYS true from CROSS onwards, by definition! ErrDumpLen 8 / 5 - constant maxDump FCBlen HOLDlen + PADlen + TIBlen + ErrDumpLen + 8 + constant FBlkLen \ the extra 8 is for the object header entry_point_toc_offset constant entry_point_TOC_offset \ ================================== $ 33333333 value dd \ marker for start of data area, \ straight after TOC $ 100000 value SPARE_CODE_SIZE $ 10000 value SPARE_DATA_SIZE ' null vect OBJINIT \ initializes Mops objects 0 value CDP 0 value DP 0 value mod_seg# \ code seg# of currently running module, or 0 0 value comp_seg# \ code seg# of module being compiled, or 0 0 value last_RP_seg# \ seg# of last reloc pointer processed by @abs 0 value prev_CDP \ used in finding range for fix_caches 0 value PAD 0 value TIB 0 value ^errDump 0 value theRgn 0 value SP0 0 value RP0 0 value FSP0 0 value CONTEXT false value instld? true value fWind? false value EMIT? 0 value code_start 0 value nuc_code_start 0 value code_limit 0 value data_start 0 value nuc_data_start 0 value data_limit 0 value SYSTEM_ERR# false value bugtest? variable ftemp 4 reserve \ temp area for FP stuff -1 value modcode_comp_start -1 value moddata_comp_start 0 value compmod \ addr of module object during compilation \ of that module, otherwise zero 64 constant max_segs \ allows us 31 modules, since each \ has a code and data segment. \ Change if necessary. variable segTable max_segs 3 << reserve forward DIE \ ( err# -- ) our normal Mops error handling word forward RUN \ ( -- ) starts running after we set everything up forward ENTERMOD \ ( xt -- ) in zModules. Calls a word in a module. forward .S forward FIX_CACHES forward fmrk \ : HERE inline{ DP} ; (* ====================== Objects, etc. ============================ These are the ones we need for the very early stuff, before our full object handling is loaded. We therefore need to wind them by hand, and in some cases patch them later. *) create FFCB 8 allot \ will be an object pointer (createObj) fWind $ 9C allot 8 allot $ 2E allot (createObj) fpRect 8 allot (createObj) fEvent 18 allot \ ivars space 4 , \ indexed elt width - &&&& changed from 2 to 4 bytes 23 , \ #elts - 1 24 4* allot \ allocate space for them \ ## note we set the offset to the indexed area in file Event \ when we set the class pointer, since that's what we do on \ the 68k and also it's easier to make changes. 0 value InterfaceLib_connID 0 value MathLib_connID variable vConnID variable mainAddr variable symAddr variable symClass $ 1234 , create qd 512 allot $ 4567 , \ size of QD globals - 206 plus a generous safety \ margin which we seem to need for some unknown \ reason create errName \ can use same space as the following: create BUF255 256 allot \ buffer for string operations \ we need these very early: \ $ BD3E 0 special_op >R \ $ BD3F 0 special_op R> \ R@ is defined in cg5 since it's just a base-displ fetch \ Currently I'm using locked handles for things like the dictionary \ area - I could use pointers but using handles allows the possibility \ of a dynamic size change if we ever want it. : lockedHndl { siz \ hndl addr -- addr } siz %_NewHandleClear -> hndl hndl %_MoveHHi hndl %_HLock hndl @ -> addr addr ; \ inline calls are a bit long-winded, so here we factor out a couple that \ we need several times: : BYE %_ExitToShell ; : call_BlockMove \ ( src dst len -- ) Just to save some space, since \ inline calls are a bit long-winded. We use BlockMove \ at this stage rather than BlockMoveData, since we \ might be moving code. %_BlockMove ; : BEEP %_SysBeep ; : ?startUpError \ ( err# -- ) dup IF 3 beep bye ELSE drop THEN ; : ?symbolError \ ( err# -- ) ?dup 0EXIT -> system_err# 213 die ; : SWITCH_ME { entPt addr -- } lr>treg \ gets the return addr to treg treg entPt - \ offset of RA in code block addr + \ equivalent RA in new code block -> treg treg>lr ; \ @ABS and EXECUTE have to come here, since they're invoked by executing \ a vector, which we need in SETUP. : (@ABS) { addr \ relocAddr seg# baseAddr displ ^ST -- absAddr | -- 0 } addr @ -> relocAddr relocAddr $ ffffff and -> displ relocAddr 24 >> dup -> seg# dup 1 and NIF -> last_RP_seg# ELSE drop THEN seg# 8 < seg# max_segs 8 + >= or IF 0 EXIT THEN seg# 8 - 8 * segTable + -> ^ST \ get addr of the seg table entry we want \ OK so far - now we check if the displ is within the segment \ this check will also trap an unallocated segment which will \ have zero length. displ ^ST @ $ 00ffffff and u>= IF 0 EXIT THEN \ err if displ out of bounds ^ST 4+ @ -> baseAddr baseAddr nilP = IF 206 die THEN \ internal error if seg absent baseAddr displ + ; : @ABS ( ^relocAddr -- absAddr ) (@abs) dup ?EXIT drop 70 die \ "not a reloc addr" ; (* For EXECUTE, we have to resort to assembly since we have to get the right number of stack cells into regs as required by the defn we're calling, and ditto for the returned results. On entry, r4 (TOS) = cfa of defn. This is the addr of the flag bytes. The actual code starts 2 bytes later. Note all assemby defns are assumed to have r4 = TOS and r3 = second, on both entry and exit. We override this in EXECUTE - see the comment there. *) forward execErr :ppc_code PUSHES r10 -32 rSP stw, r9 -28 rSP stw, r8 -24 rSP stw, r7 -20 rSP stw, r6 -16 rSP stw, r5 -12 rSP stw, r4 -8 rSP stw, r3 -4 rSP stw, blr, ;ppc_code :ppc_code PULLS r10 4 rSP lwzu, r9 4 rSP lwzu, r8 4 rSP lwzu, r7 4 rSP lwzu, r6 4 rSP lwzu, r5 4 rSP lwzu, r4 4 rSP lwzu, r3 4 rSP lwzu, blr, ;ppc_code :ppc_code FPUSHES fr8 -64 rFSP stfd, fr7 -56 rFSP stfd, fr6 -48 rFSP stfd, fr5 -40 rFSP stfd, fr4 -32 rFSP stfd, fr3 -24 rFSP stfd, fr2 -16 rFSP stfd, fr1 -8 rFSP stfd, blr, ;ppc_code :ppc_code FPULLS fr10 8 rFSP lfdu, fr9 8 rFSP lfdu, fr8 8 rFSP lfdu, fr7 8 rFSP lfdu, fr6 8 rFSP lfdu, fr5 8 rFSP lfdu, fr4 8 rFSP lfdu, fr3 8 rFSP lfdu, fr2 8 rFSP lfdu, fr1 8 rFSP lfdu, blr, ;ppc_code :ppc_code PULLPARMS r24 4 rSP lwzu, r25 4 rSP lwzu, r26 4 rSP lwzu, r27 4 rSP lwzu, r28 4 rSP lwzu, r29 4 rSP lwzu, r30 4 rSP lwzu, r31 4 rSP lwzu, blr, ;ppc_code :ppc_code FPULLPARMS fr24 8 rFSP lfdu, fr25 8 rFSP lfdu, fr26 8 rFSP lfdu, fr27 8 rFSP lfdu, fr28 8 rFSP lfdu, fr29 8 rFSP lfdu, fr30 8 rFSP lfdu, fr31 8 rFSP lfdu, blr, ;ppc_code :ppc_code SAVES r21 -44 rRP stw, r22 -40 rRP stw, r23 -36 rRP stw, r24 -32 rRP stw, r25 -28 rRP stw, r26 -24 rRP stw, r27 -20 rRP stw, r28 -16 rRP stw, r29 -12 rRP stw, r30 -8 rRP stw, r31 -4 rRP stw, blr, ;ppc_code :ppc_code RESTORES r21 -44 rRP lwz, r22 -40 rRP lwz, r23 -36 rRP lwz, r24 -32 rRP lwz, r25 -28 rRP lwz, r26 -24 rRP lwz, r27 -20 rRP lwz, r28 -16 rRP lwz, r29 -12 rRP lwz, r30 -8 rRP lwz, r31 -4 rRP lwz, blr, ;ppc_code :ppc_code FSAVES fr21 -88 rRP stfd, fr22 -80 rRP stfd, fr23 -72 rRP stfd, fr24 -64 rRP stfd, fr25 -56 rRP stfd, fr26 -48 rRP stfd, fr27 -40 rRP stfd, fr28 -32 rRP stfd, fr29 -24 rRP stfd, fr30 -16 rRP stfd, fr31 -8 rRP stfd, blr, ;ppc_code :ppc_code FRESTORES fr21 -88 rRP lfd, fr22 -80 rRP lfd, fr23 -72 rRP lfd, fr24 -64 rRP lfd, fr25 -56 rRP lfd, fr26 -48 rRP lfd, fr27 -40 rRP lfd, fr28 -32 rRP lfd, fr29 -24 rRP lfd, fr30 -16 rRP lfd, fr31 -8 rRP lfd, blr, ;ppc_code :ppc_code (EX) \ called from EXECUTE, once we've handled a possible \ indirection via a vector. \ in a code defn we always have 2 stack cells and 2 floating stack cells in regs on \ entry. So here we have r4 = xt to execute, r3 = next cell down. We can scribble \ on r5-10 until we get the parms into regs. \ If this is a method, the obj addr will be rY (r12), so we have to leave \ that alone for the first part. r0 mflr, \ save lr on return stack r0 -8 rRP stwu, fr2 -16 rFSP stfd, \ push of fr1 and fr2 - all FP stk cells now in mem fr1 -8 rFSP stfd, rFSP -24 addi, \ leave rFSP 8 bytes lower than usual, to simplify \ what follows rX r4 mr, \ rX = addr of flag bytes of defn we're executing r5 -2 rX lhz, \ r5 = handler code, which we now check r0 r5 $ FF00 andi., \ BExx is OK r0 $ BE00 cmpli, ne if, r0 $ BD00 cmpli, eq if, r6 rX lhz, \ OK - there'll be boilerplate code after r6 r6 $ FF andi., \ the info bytes. r6 = # info bytes rX rX r6 add, \ add to addr in rX. Now we need to add 2 for \ the extra info mark and len, then off-align (by \ adding 5, 4-byte aligning, then subtracting 2) rX rX 7 addi, \ so we combine the 5 and 2 and add 7 rX rX 0 0 29 rlwinm, \ back to 4-byte boundary rX rX -2 addi, \ now rX -> flag bytes for boilerplate code else, r0 ' execErr 2+ dicaddr, r0 mtctr, bctr, then, then, \ now we get the flag bytes to r6, and the FP flag bytes to r7. r6 0 rX lhz, \ r6 = flag bytes r3 -4 rSP stw, \ push off r3 - all stk cells are now in mem rSP -8 addi, \ leave rSP 4 bytes lower than usual, to simplify \ what follows r0 r6 $ 1000 andi., \ look at "fp" bit in flags ne if, r7 4 rX lhz, \ if set, get FP flag bytes to r7 else, r7 $ 0200 li, \ otherwise put default flag bytes there then, r0 r6 $ 8000 andi., \ look at "leaf" bit in flags ne if, \ it's a leaf routine. We do the work of the prolog and epilog here rather than in \ the called routine. r3 is unused here so we can use it. \ First we save the FPRs, since we know RP is 8-byte aligned: r3 r7 2 26 29 rlwinm, \ r3 = # FP parm+locals, times 4 r0 ' fsaves 46 + dicaddr, \ addr of end of "fsaves" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ save the required FP regs r0 r3 r3 add, \ double offset for rRP decrement rRP r0 rRP subf, \ decrement rRP over saved FPRs \ Now we save the GPRs: r3 r6 2 26 29 rlwinm, \ r3 = # parms+locals, times 4 r0 ' saves 46 + dicaddr, \ addr of end of "saves" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ save the required regs rRP r3 rRP subf, \ decrement rRP over saved regs r0 r5 $ FF andi., r0 $ 40 cmpli, \ method? eq if, r20 -4 rRP stwu, \ yes - save r20 r20 rY mr, \ and move rY to there then, \ now we look after the parms themselves - we set up for them to go straight to \ their ultimate destination regs. First any FP parms: r3 r7 30 26 29 rlwinm, \ r3 = # FP parms, times 4 r0 ' fpullParms 34 + dicaddr, \ addr of end of "pullParms" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the FP parms we need into regs up to fr31 \ now we look after any FP stack cells that have to go to regs - this will only \ happen if our default call_cnt (2) is greater than the number of named parms. \ Note the most pulls we'll do is to fr1 and fr2. r0 8 li, r3 r3 r0 subf., \ r3 = 8 - ( # FP parms * 4 ) gt if, r0 ' fpulls 42 + dicaddr, \ addr of end of "pulls" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the floating stack cells we need into regs then, r3 r6 30 26 29 rlwinm, \ r3 = # parm bytes r0 ' pullParms 34 + dicaddr, \ addr of end of "pullParms" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the parms we need into regs up to r31 \ now we look after any stack cells that have to go to regs - this will only \ happen if our default call_cnt (2) is greater than the number of named parms. \ Note the most pulls we'll do is to r3 and r4, so r5-7 will be untouched. r0 8 li, r3 r3 r0 subf., \ r3 = 8 - # parm bytes gt if, r0 ' pulls 34 + dicaddr, \ addr of end of "pulls" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the stack cells we need into regs then, \ before we call the routine we save the flag bytes, the handler code and rX, \ since we need them later. In this leaf handling code we have to do this \ last since we've saved regs for the callee, and we'll need to restore \ these quantities first. r5 -4 rRP stwu, r6 -4 rRP stwu, rX -4 rRP stwu, else, \ not a leaf routine. \ first we save the same quantities as above - but here we have to do it first, \ since we might be clobbering r5/r6 if the callee needs them. r5 -4 rRP stwu, r6 -4 rRP stwu, rX -4 rRP stwu, r3 r7 30 26 29 rlwinm, \ r3 = # fp parms, times 4 r0 8 li, r3 r0 cmp, lt if, r3 r0 mr, \ if < 8, make it 8 since that's our minimum then, r0 ' fpulls 42 + dicaddr, \ addr of end of "fpulls" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the fp cells we need into fp regs r3 r6 30 26 29 rlwinm, \ r3 = # parms, times 4 r0 8 li, r3 r0 cmp, lt if, r3 r0 mr, \ if < 8, make it 8 since that's our minimum then, r0 ' pulls 34 + dicaddr, \ addr of end of "pulls" code to r0 r0 r3 r0 subf, \ subtract offset r0 mtctr, bctrl, \ pull the cells we need into regs then, rSP 4 addi, \ stack ptrs back to normal rFSP 8 addi, \ now we have to 8-byte align the RP since anything might happen in the callee. \ If we have to do it we'll push a 4-byte zero. Since rX, the last reg we saved \ there, can never be zero, this lets us sorts things out when the callee returns. r0 rRP 7 andi., ne if, r0 0 li, r0 -4 rRP stwu, then, \ now we're going to call the routine - first we need the address of its \ first instruction. r0 r6 $ 1000 andi., \ look at "fp" bit in flags ne if, r0 rX 6 addi, else, r0 rX 2 addi, \ addr of code to r0 then, r0 mtctr, \ ************************************************************************** bctrl, \ call it \ ************************************************************************** \ At this point we have to allow for the maximum number of live values \ in GPRs, which is 6. This means r9 will always be free here, \ and we can also use r0, rX, rY and rZ (aka r10). rX 0 rRP lwz, \ restore rX rX 0 cmpi, eq if, \ but if we got zero, it was alignment rRP 4 addi, \ padding, so we skip it and try again rX 0 rRP lwz, \ restore rX then, r10 4 rRP lwz, \ restore flag bytes, into r10 this time r9 8 rRP lwz, \ restore handler code to r9 rRP 12 addi, \ all we need from the handler code is whether this is a method or not, so \ we'll get this to cr1, then we can reuse r9. r0 r9 $ FF andi., cr1 r0 $ 40 cmpli, \ cr1 is "equal" if it's a method r0 r10 $ 1000 andi., \ look at "fp" bit in flags ne if, r9 4 rX lhz, \ if set, get FP flag bytes to r9 else, r9 $ 0200 li, \ otherwise put default flag bytes there then, r0 r10 $ 8000 andi., \ test "leaf" bit in flags ne if, \ it was a leaf routine. cr1 eq if, \ method? r20 rRP lwz, \ yes - restore r20 rRP 4 addi, then, rY r10 2 26 29 rlwinm, \ rY = # parms+locals, times 4 r0 ' restores 46 + dicaddr, \ addr of end of "restores" code to r0 r0 rY r0 subf, \ subtract offset rRP rRP rY add, \ increment rRP over saved GPRs r0 mtctr, bctrl, \ restore the saved regs rY r9 2 26 29 rlwinm, \ rY = # FP parm+locals, times 4 r0 ' frestores 46 + dicaddr, \ addr of end of "frestores" code to r0 r0 rY r0 subf, \ subtract offset rRP rY add, \ increment rRP over saved FPRs (8 bytes rRP rY add, \ each) r0 mtctr, bctrl, \ restore the saved FPRs then, \ now we push off all result regs to mem - we return 2 in GPRs and 2 in FPRs \ from here, but it's easiest to grab those back after the pushes. rY r10 26 26 29 rlwinm, \ rY = # result regs, times 4 r0 ' pushes 34 + dicaddr, \ addr of end of "pushes" code to r0 r0 rY r0 subf, \ subtract offset r0 mtctr, bctrl, \ push all result regs to mem rSP rY rSP subf, \ adjust stack ptr rY r9 26 26 29 rlwinm, \ rY = # FP result regs, times 4 r0 ' fpushes 34 + dicaddr, \ addr of end of "fpushes" code to r0 r0 rY r0 subf, \ subtract offset r0 mtctr, bctrl, \ push all result regs to mem rY rY add, rFSP rY rFSP subf, \ adjust stack ptr r4 0 rSP lwz, r3 4 rSP lwz, rSP 8 addi, fr2 0 rFSP lfd, fr1 8 rFSP lfd, rFSP 16 addi, r0 0 rRP lwz, rRP 8 addi, r0 mtlr, \ restore lr blr, \ and return. ;ppc_code uses_ctr : EXECUTE ( xt -- ?? ) dup 2- w@ $ BC41 = IF \ it's a MARKER 2+ fmrk EXIT THEN dup 2- w@ $ BC0C = IF \ it's a DOES> word dup 2+ @abs \ get addr of CREATEd data swap 6 + @abs \ and xt of DOES> code ELSE BEGIN dup 2- w@ $ BC05 = WHILE \ it's a vector 2+ @abs \ goto data area @abs \ pick up dest xt REPEAT \ and loop in case we get another vector dup 2- w@ $ BD2E = IF \ it's an exported word ['] enterMod \ for these we execute enterMod which THEN \ does the work THEN (ex) \ (ex) does the actual work of executing the word ; : DoVect @abs execute ; : DoSvect dup @ NIF 4+ THEN @abs execute ; : ^THEPORT ( -- addr ) inline{ qd 256 +} ; \ should theoretically only be 110, but we \ seem to need more - see comment at qd : THEPORT ( -- addr-of-GrafPort ) inline{ qd 256 + @} ; : SCREENBITS { \ ^rect -- l t r b } qd $ 8c + -> ^rect ^rect 2+ w@ ^rect w@ ^rect 6 + w@ ^rect 4+ w@ ; (* SAVE_MOPS_REGS saves the Mops base address regs and stack pointers into the TOC area. We need these saved values for callbacks, and also if if we're a shared library - in these situations we have to restore the Mops environment before we can do anything else. These saved values come at the end of our TOC. TOC_size is currently 132. If it changes, we'll have to change the numbers here, and in get_transition_vector below, and also in :ppc_proc and ;ppc_proc in zObjinit. *) :ppc_code SAVE_MOPS_REGS r13 104 rTOC stw, r14 108 rTOC stw, r15 112 rTOC stw, r16 116 rTOC stw, r17 120 rTOC stw, r18 124 rTOC stw, r19 128 rTOC stw, blr, ;ppc_code \ we call PREPARE_SYSCALLS at startup time to get the shared libraries \ we need. Currently, these are InterfaceLib and MathLib. : get_shared_library { addr -- connID true | -- false } addr \ addr is pascal string 'type pwpc \ PowerPC library 1 \ load the library if not loaded vConnID mainAddr errName %_GetSharedLibrary ?dup IF -> system_err# false EXIT THEN vConnID @ true ; : get_connID { ^extern \ ^lib ^connID -- connID } \ gets the connID for an arbitrary shared library ^extern 10 + @abs -> ^lib ^lib 2+ @abs -> ^connID ^connID @ ?dup ?EXIT \ not connected yet - we do it now ^lib 6 + get_shared_library NIF 220 die THEN \ could not load shared library dup ^connID ! ; : PREPARE_SYSCALLS ( -- ) " InterfaceLib" drop 1- get_shared_library not ?startUpError -> InterfaceLib_connID " MathLib" drop 1- get_shared_library not ?startUpError -> MathLib_connID ; 0 value tvtest : get_transition_vector { ^extern \ extern? ^tv connID -- } ^extern 10 + @ IF \ this is a LIBCALL. We look in the given library. ^extern get_connID ELSE \ it's a syscall. We look in InterfaceLib and MathLib. InterfaceLib_connID THEN -> connID ^extern 6 + @abs -> ^tv ^tv @ nilP = IF \ hasn't been called yet - we resolve it now connID ^extern 14 + \ addr of symbol (Pascal string) ^tv \ addr of location where resolved pointer will go symClass %_FindSymbol IF \ didn't find it there - try in MathLib MathLib_connID ^extern 14 + \ addr of symbol (Pascal string) ^tv \ addr of location where resolved pointer will go symClass %_FindSymbol ?symbolError \ if we still didn't find it, fail THEN THEN tvtest if dbgr then modcode rTOC 112 + ! \ set global copies of module base regs moddata rTOC 116 + ! \ in case there's a callback ^tv @ -> rY \ r12 -> transition vector [ $ 800C0000 code, \ lwz r0, (r12) - get dest addr to r0 $ 7C0903A6 code, \ mtctr r0 - and then to ctr ] ; : SETUP { \ hndl addr entPt codeSz dataSz cg_code cg_data total_code total_data flags chopped -- } initial_entry_point fix_sys_SP \ First we grow the application heap: %_MaxApplZone \ now we allocate a block for the return stack: rstack_size %_NewHandleClear -> hndl hndl %_MoveHHi hndl %_HLock hndl @ -> addr addr rstack_size + -> RP \ RP is set up - now we can do calls! $ CD $ AB \ leave markers on the stack - these might also \ hopefully catch a stack underflow $ CDCD >r $ ABAB >r \ and also on the return stack \ now we grab the items we need out of the info block \ at the start of the code area entry_point_toc_offset RTOC + @ -> entPt entPt 4 + @ -> codeSz entPt 8 + @ -> dataSz entPt 12 + @ -> cg_code entPt 16 + @ -> cg_data entPt 52 + @ -> flags \ now we set up the base regs and the segment table so we can \ address things. First the data area: flags 1 and IF \ this is an installed app. dataSz -> total_data RTOC -> addr ELSE \ we're in the development environment, so the data \ area goes in a handle: entPt 68 + @ -> total_data total_data lockedHndl -> addr RTOC addr dataSz call_BlockMove THEN addr cg_data + half_displ_range + -> mainData -1 -> modData \ with the data area set up, we can now store to it! total_data dataSz - -> spare_data_size entPt 60 + @ -> chopped total_data chopped + segTable 8 + ! addr chopped - segTable 12 + ! addr -> data_start addr cg_data + -> nuc_data_start addr total_data + -> data_limit addr dataSz + -> DP \ now the code area flags 1 and IF \ this is an installed app. \ true -> instld? \ in case it wasn't set already codeSz -> total_code entPt -> addr ELSE entPt 64 + @ -> total_code total_code lockedHndl -> addr entPt addr codeSz call_BlockMove THEN addr cg_code + half_displ_range + -> mainCode -1 -> modCode total_code codeSz - -> spare_code_size entPt 56 + @ -> chopped total_code chopped + segTable ! addr chopped - segTable 4+ ! addr -> code_start addr cg_code + -> nuc_code_start addr total_code + -> code_limit addr codeSz + dup -> CDP -> prev_CDP addr 20 + -> context flags 1 and NIF \ development addr codeSz %_MakeDataExecutable \ now the interesting bit - we switch execution into the handle \ where we just moved the code! entPt addr switch_me THEN \ now the FP stack area: fstack_size 20 + lockedHndl fstack_size + -> FSP \ now set up the values with the base addrs of the 3 stacks: SP -> SP0 \ no cells in regs just here, as it turns out RP -> RP0 -1 -> (^base) \ no current object $ 7ff86400 ftemp ! \ quiet NAN(100) ftemp sf@ ftemp sf@ \ put 4 of them at base of FP stack ftemp sf@ ftemp sf@ 0 ftemp ! ftemp f@ -> 0.0 \ initialize fpr14 to zero (we use it \ as a permanent source of zero) (* Now we init the managers. Note: it seems, for some reason, that if we call InitGraf in a shared library at init time, we crash the calling application when it next calls QD. Maybe QD doesn't like multiple InitGrafs within the one thread, even though we're using separate copies of the QD globals. Anyway, for now, let's skip the InitGraf if this is a shared library. *) flags 2 and nif ^thePort %_InitGraf \ note: what we have to pass to InitGraf is the \ addr of thePort which is a pointer near the END \ of the QD globals record! %_InitFonts %_InitWindows %_TeInit %_InitMenus %_InitCursor then FSP 48 - -> FSP0 \ The external calls have pushed all our dummy FP \ cells into mem at this point \ now we allocate a block for fFcb, TIB, PAD and the error dump area, and \ set up fFcb (which is an object pointer) pointing there. fFcb will be set up \ properly when Files is loaded. FBlkLen 10 + lockedHndl -> addr \ the 10 is just a safety margin 8 ++> addr \ leave room for obj header addr ffcb ! FCBlen ++> addr addr -> pad PADlen ++> addr addr -> TIB TIBlen ++> addr addr -> ^errDump \ Noe we get the shared lib for system calls. After this we can \ execute syscall words. prepare_syscalls %_NewRgn -> theRgn \ now if needed, we get our low-level window fWind. fWind? IF 256 \ resID fWind -1 %_GetNewWindow %_SetPort fWind -> addr 9 addr 74 + w! \ point size = 9 4 addr 68 + w! \ font = Monaco addr 16 + @ addr 156 + ! \ set fWind's contRect in case not done addr 20 + @ addr 160 + ! addr 16 + @ fpRect ! \ set fpRect (used for scrolling) addr 20 + @ fpRect 4 + ! \ %_NewRgn -> theRgn 0 %_TextMode true -> emit? THEN objInit \ now we save a copy of the Mops base regs and stack pointers \ in the TOC, for :ppc_proc and :entry save_Mops_regs flags 2 and \ is this a shared library initialization call? IF \ yes - restore everything and return to caller init_end ELSE \ no - start normal Mops execution run %_ExitToShell THEN ;